home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtutils.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  21.6 KB  |  707 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtUtils;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 24.01.92 |  Hp  | Die Routinen fr Objektmanipulation    *
  29.  *           |          |      | wurden so angepasst, daž sie sowohl    *
  30.  *           |          |      | mit normalen als auch mit Userdef-     *
  31.  *           |          |      | Objekten zurechtkommen! Dabei gehen    *
  32.  *           |          |      | die Routinen davon aus, daž die User-  *
  33.  *           |          |      | def-Objekte mit dem Moduls mtXobjects  *
  34.  *           |          |      | installiert wurden.                    *
  35.  *  3.02     | 03.02.92 |  Hp  | SetState und SetFlag implementiert.    *
  36.  *----------------------------------------------------------------------*)
  37.  
  38.  
  39.  
  40.  
  41. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  42. (*                                              *)
  43. (*$R-   Range-Checks                            *)
  44. (*$S-   Stack-Check                             *)
  45. (*                                              *)
  46. (*----------------------------------------------*)
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  54.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  55.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  56.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  57.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  58.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  59.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  60.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67. FROM SYSTEM             IMPORT  ADDRESS, ADR;
  68. FROM MagicStrings       IMPORT  Assign, Append, Length, Pos, Cap;
  69. FROM MagicAES           IMPORT  GBOX, GTEXT, GBOXTEXT, GIMAGE, GPROGDEF, GIBOX,
  70.                                 GBUTTON, GBOXCHAR, GSTRING, GFTEXT, GFBOXTEXT,
  71.                                 GICON, GCICON, GTITLE, SELECTABLE, DEFAULT, Exit,
  72.                                 EDITABLE, RBUTTON, LASTOB, TOUCHEXIT, HIDETREE,
  73.                                 INDIRECT, SELECTED, CROSSED, CHECKED, DISABLED,
  74.                                 OUTLINED, SHADOWED, DRAW3D, WHITEBAK, OBJECT,
  75.                                 GrafMkstate, ARROW, FLATHAND, GrafMouse,
  76.                                 ObjcOffset;
  77.                         IMPORT  MagicAES, MagicXBIOS, mtXobjects;
  78.  
  79. (*----------------------------------------------------------------------*
  80.  *                      Einfache Rechenfunktioen                        *
  81.  *----------------------------------------------------------------------*)
  82.  
  83. PROCEDURE Min (c1, c2: sINTEGER): sINTEGER;
  84. BEGIN
  85.  IF c1 < c2 THEN RETURN VAL (INTEGER, c1);
  86.             ELSE RETURN VAL (INTEGER, c2);
  87.  END;
  88. END Min;
  89.  
  90. PROCEDURE Max (c1, c2: sINTEGER): sINTEGER;
  91. BEGIN
  92.  IF c1 < c2 THEN RETURN VAL (INTEGER, c2);
  93.             ELSE RETURN VAL (INTEGER, c1);
  94.  END;
  95. END Max;
  96.  
  97. (*----------------------------------------------------------------------*)
  98.  
  99. PROCEDURE GetHibyte (value: sINTEGER): sINTEGER;
  100. VAR t: AnyType;
  101. BEGIN
  102.  t.lint:= value;  RETURN  CastToInt (t.b2);
  103. END GetHibyte;
  104.  
  105. PROCEDURE GetLowbyte (value: sINTEGER): sINTEGER;
  106. VAR t: AnyType;
  107. BEGIN
  108.  t.lint:= value;  RETURN  CastToInt (t.b1);
  109. END GetLowbyte;
  110.  
  111. (*----------------------------------------------------------------------*)
  112.  
  113. PROCEDURE InclFlag (tree: ADDRESS; entry, bit: sINTEGER);
  114. VAR dial: tObjcTree;
  115. BEGIN
  116.  dial:= tree;  INCL(dial^[entry].obFlags, bit);
  117. END InclFlag;
  118.  
  119. PROCEDURE ExclFlag (tree: ADDRESS; entry, bit: sINTEGER);
  120. VAR dial: tObjcTree;
  121. BEGIN
  122.  dial:= tree;  EXCL(dial^[entry].obFlags, bit);
  123. END ExclFlag;
  124.  
  125. PROCEDURE SetFlag (tree: ADDRESS; entry, bit: sINTEGER; set: BOOLEAN);
  126. VAR dial: tObjcTree;
  127. BEGIN
  128.  dial:= tree;
  129.  IF set THEN INCL (dial^[entry].obFlags, bit);
  130.         ELSE EXCL (dial^[entry].obFlags, bit);
  131.  END;
  132. END SetFlag;
  133.  
  134. PROCEDURE InFlag (tree: ADDRESS; entry, bit: sINTEGER): BOOLEAN;
  135. VAR dial: tObjcTree;
  136. BEGIN
  137.  dial:= tree;  RETURN (CastToCard (bit) IN dial^[entry].obFlags);
  138. END InFlag;
  139.  
  140. PROCEDURE InclState (tree: ADDRESS; entry, bit: sINTEGER);
  141. VAR dial: tObjcTree;
  142. BEGIN
  143.  dial:= tree;  INCL(dial^[entry].obState, bit);
  144. END InclState;
  145.  
  146. PROCEDURE ExclState (tree: ADDRESS; entry, bit: sINTEGER);
  147. VAR dial: tObjcTree;
  148. BEGIN
  149.  dial:= tree;  EXCL(dial^[entry].obState, bit);
  150. END ExclState;
  151.  
  152. PROCEDURE SetState (tree: ADDRESS; entry, bit: sINTEGER; set: BOOLEAN);
  153. VAR dial: tObjcTree;
  154. BEGIN
  155.  dial:= tree;
  156.  IF set THEN INCL (dial^[entry].obState, bit);
  157.         ELSE EXCL (dial^[entry].obState, bit);
  158.  END;
  159. END SetState;
  160.  
  161. PROCEDURE InState (tree: ADDRESS; entry, bit: sINTEGER): BOOLEAN;
  162. VAR dial: tObjcTree;
  163. BEGIN
  164.  dial:= tree;  RETURN (CastToCard (bit) IN dial^[entry].obState);
  165. END InState;
  166.  
  167. PROCEDURE GetThreeState (tree: ADDRESS; entry : sINTEGER): sINTEGER;
  168. VAR dial: tObjcTree;
  169.     state : sBITSET;
  170.     checked,
  171.     sel   : BOOLEAN;
  172. BEGIN
  173.   dial := tree;
  174.   state := dial^[entry].obState;
  175.   checked := CHECKED IN state;
  176.   sel     := SELECTED IN state;
  177.   IF checked & sel
  178.   THEN 
  179.     RETURN SETNEW
  180.   ELSIF ~checked & sel
  181.   THEN
  182.     RETURN CLEAR
  183.   ELSIF ~checked & ~sel
  184.   THEN
  185.     RETURN NOCHANGE
  186.   ELSE
  187.     RETURN -1  (* FEHLER *)
  188.   END;
  189. END GetThreeState;
  190.  
  191. PROCEDURE SetThreeState (tree: ADDRESS; entry, val : sINTEGER);
  192. BEGIN
  193.   CASE val OF
  194.     0 : ExclState (tree, entry, SELECTED);
  195.         ExclState (tree, entry, CHECKED);  |
  196.     1 : InclState (tree, entry, SELECTED);
  197.         ExclState (tree, entry, CHECKED);  |
  198.     2 : InclState (tree, entry, SELECTED);
  199.         InclState (tree, entry, CHECKED);  |
  200.   ELSE
  201.   END;
  202. END SetThreeState;
  203. (*----------------------------------------------------------------------*)
  204.  
  205. TYPE Typeset =    SET OF [GBOX..GCICON];
  206.      PtrUSERBLK = POINTER TO USERBLK;
  207.      USERBLK =    RECORD
  208.                    ubCode: PROC;
  209.                    ubPara: MagicAES.Objcspec;
  210.                   END;
  211.  
  212.  
  213. PROCEDURE ObjcString (tree: ADDRESS; entry: sINTEGER; VAR str: ARRAY OF CHAR);
  214. VAR dial: tObjcTree;
  215.     ob:   sCARDINAL;
  216.     pd:   BOOLEAN;
  217.     ub:   PtrUSERBLK;
  218. BEGIN
  219.  dial:= tree;  pd:= FALSE;
  220.  WITH dial^[entry] DO
  221.   IF obType = GPROGDEF THEN
  222.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  223.   END;
  224.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  225.   IF ob = GBOXCHAR THEN
  226.    IF pd THEN  str[0]:= ub^.ubPara.Box.char;
  227.          ELSE  str[0]:= obSpec.Box.char;
  228.    END;
  229.   ELSIF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  230.    IF pd THEN  Assign (ub^.ubPara.TedPtr^.tePtext^, str);
  231.          ELSE  Assign (obSpec.TedPtr^.tePtext^, str);
  232.    END;
  233.   ELSIF ob IN Typeset {GBUTTON, GSTRING, GTITLE} THEN
  234.    IF pd THEN  Assign (ub^.ubPara.StringPtr^, str);
  235.          ELSE  Assign (obSpec.StringPtr^, str);
  236.    END;
  237.   END;
  238.  END;
  239. END ObjcString;
  240.  
  241. PROCEDURE ObjcStringAdr (tree: ADDRESS; entry: sINTEGER): ADDRESS;
  242. VAR dial: tObjcTree;
  243.     ob:   sCARDINAL;
  244.     pd:   BOOLEAN;
  245.     ub:   PtrUSERBLK;
  246. BEGIN
  247.  dial:= tree;  pd:= FALSE;
  248.  WITH dial^[entry] DO
  249.   IF obType = GPROGDEF THEN
  250.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  251.   END;
  252.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  253.   IF ob = GBOXCHAR THEN
  254.    IF pd THEN  RETURN ADR (ub^.ubPara.Box.char);
  255.          ELSE  RETURN ADR (obSpec.Box.char);
  256.    END;
  257.   ELSIF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  258.    IF pd THEN  RETURN ub^.ubPara.TedPtr^.tePtext;
  259.          ELSE  RETURN obSpec.TedPtr^.tePtext;
  260.    END;
  261.   ELSIF ob IN Typeset {GBUTTON, GSTRING, GTITLE} THEN
  262.    IF pd THEN  RETURN ub^.ubPara.StringPtr;
  263.          ELSE  RETURN obSpec.StringPtr;
  264.    END;
  265.   END;
  266.  END;
  267. END ObjcStringAdr;
  268.  
  269. PROCEDURE SetObjcString (tree: ADDRESS; entry: sINTEGER; REF  str: ARRAY OF CHAR);
  270. VAR dial: tObjcTree;
  271.     hi, tl: sINTEGER;
  272.     (*$Reg*)  i: sINTEGER;
  273.     ob, c:  sCARDINAL;
  274.     pd:   BOOLEAN;
  275.     ub:   PtrUSERBLK;
  276.     ip:   MagicAES.PtrICONBLK;
  277. BEGIN
  278.  dial:= tree;  c:= HIGH (str);  hi:= CastToInt (c);  pd:= FALSE;
  279.  WITH dial^[entry] DO
  280.   IF obType = GPROGDEF THEN
  281.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  282.   END;
  283.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  284.   IF ob = GBOXCHAR THEN 
  285.    IF pd THEN ub^.ubPara.Box.char:= str[0];
  286.          ELSE obSpec.Box.char:= str[0];
  287.    END;
  288.   ELSIF ob IN Typeset {GICON, GCICON} THEN
  289.    i:= 0;
  290.    IF ob = GICON
  291.    THEN
  292.      IF pd THEN
  293.        ip := ub^.ubPara.IconPtr;
  294.      ELSE
  295.        ip := obSpec.IconPtr;
  296.      END;
  297.    ELSE
  298.      IF pd THEN
  299.        ip := ADDRESS(ub^.ubPara.CiconPtr);
  300.      ELSE
  301.        ip := ADDRESS(obSpec.CiconPtr);
  302.      END;
  303.    END;
  304.    WHILE ip^.ibPtext^[i] # 0C DO
  305.      ip^.ibPtext^[i]:= ' ';  INC (i);
  306.    END;
  307.    FOR i:= 0 TO hi DO
  308.     IF ip^.ibPtext^[i] = 0C THEN  RETURN;  END;
  309.     IF str[i] = 0C THEN  RETURN;  END;
  310.     ip^.ibPtext^[i]:= str[i];
  311.    END;
  312.   ELSIF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  313.    IF pd THEN tl:= ub^.ubPara.TedPtr^.teTxtlen-1;
  314.          ELSE tl:= obSpec.TedPtr^.teTxtlen-1;
  315.    END;
  316.    FOR i:= 0 TO hi DO
  317.     IF i = tl THEN  RETURN;  END;
  318.     IF pd THEN  ub^.ubPara.TedPtr^.tePtext^[i]:= str[i];
  319.           ELSE  obSpec.TedPtr^.tePtext^[i]:= str[i];
  320.     END;
  321.     IF str[i] = 0C THEN  RETURN;  END;
  322.    END;
  323.   ELSIF ob IN Typeset {GBUTTON, GSTRING, GTITLE} THEN
  324.    i:= 0;
  325.    IF pd THEN
  326.     WHILE ub^.ubPara.StringPtr^[i] # 0C DO
  327.      ub^.ubPara.StringPtr^[i]:= ' ';  INC (i);
  328.     END;
  329.    ELSE
  330.     WHILE obSpec.StringPtr^[i] # 0C DO
  331.      obSpec.StringPtr^[i]:= ' ';  INC (i);
  332.     END;
  333.    END;
  334.    FOR i:= 0 TO hi DO
  335.     IF pd THEN
  336.      IF ub^.ubPara.StringPtr^[i] = 0C THEN  RETURN;  END;
  337.      IF str[i] = 0C THEN  RETURN;  END;
  338.      ub^.ubPara.StringPtr^[i]:= str[i];
  339.     ELSE
  340.      IF obSpec.StringPtr^[i] = 0C THEN  RETURN;  END;
  341.      IF str[i] = 0C THEN  RETURN;  END;
  342.      obSpec.StringPtr^[i]:= str[i];
  343.     END;
  344.    END;
  345.   END;
  346.  END;
  347. END SetObjcString;
  348.  
  349. PROCEDURE SetObjcStringAdr (tree: ADDRESS; entry: sINTEGER; str: ADDRESS);
  350. VAR dial: tObjcTree;
  351.     ob:   sCARDINAL;
  352.     pd:   BOOLEAN;
  353.     ub:   PtrUSERBLK;
  354. BEGIN
  355.  dial:= tree;  pd:= FALSE;
  356.  WITH dial^[entry] DO
  357.   IF obType = GPROGDEF THEN
  358.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  359.   END;
  360.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  361.   IF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  362.    IF pd THEN
  363.     ub^.ubPara.TedPtr^.tePtext:= str;
  364.     ub^.ubPara.TedPtr^.teTxtlen:= Length(ub^.ubPara.TedPtr^.tePtext^);
  365.    ELSE
  366.     obSpec.TedPtr^.tePtext:= str;
  367.     obSpec.TedPtr^.teTxtlen:= Length(obSpec.TedPtr^.tePtext^);
  368.    END;
  369.   ELSIF ob IN Typeset {GBUTTON, GSTRING, GTITLE} THEN
  370.    IF pd THEN  ub^.ubPara.StringPtr:= str;
  371.          ELSE  obSpec.StringPtr:= str;
  372.    END;
  373.   END;
  374.  END;
  375. END SetObjcStringAdr;
  376.  
  377. PROCEDURE ObjcStrLen (tree: ADDRESS; entry: sINTEGER; VAR txt, tmplt: sINTEGER);
  378. VAR dial: tObjcTree;
  379.     ob:   sCARDINAL;
  380.     pd:   BOOLEAN;
  381.     ub:   PtrUSERBLK;
  382. BEGIN
  383.  dial:= tree;  pd:= FALSE;  txt:= -1;  tmplt:= -1;
  384.  WITH dial^[entry] DO
  385.   IF obType = GPROGDEF THEN
  386.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  387.   END;
  388.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  389.   IF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  390.    IF pd THEN
  391.     txt:= ub^.ubPara.TedPtr^.teTxtlen;
  392.     tmplt:= ub^.ubPara.TedPtr^.teTmplen;
  393.    ELSE
  394.     txt:= obSpec.TedPtr^.teTxtlen;
  395.     tmplt:= obSpec.TedPtr^.teTmplen;
  396.    END;
  397.   ELSIF ob IN Typeset {GBUTTON, GSTRING, GTITLE} THEN
  398.    txt:= 0; tmplt:= -1;
  399.    IF pd THEN  WHILE ub^.ubPara.StringPtr^[txt] # 0C DO  INC (txt);  END;
  400.          ELSE  WHILE obSpec.StringPtr^[txt] # 0C DO  INC (txt);  END;
  401.    END;
  402.   END;
  403.  END
  404. END ObjcStrLen;
  405.  
  406. (*----------------------------------------------------------------------*)
  407.  
  408. PROCEDURE ObjcParent (tree: ADDRESS; entry: sINTEGER): sINTEGER;
  409. VAR dial: tObjcTree;
  410. BEGIN
  411.  IF entry <= 0 THEN RETURN 0; END; 
  412.  dial:= tree;
  413.  LOOP
  414.   WITH dial^[entry] DO
  415.    IF obNext < entry THEN  RETURN obNext;  END;
  416.    entry:= obNext;
  417.   END;
  418.  END;
  419. END ObjcParent;
  420.         
  421. PROCEDURE ObjcPos (tree: ADDRESS; entry: sINTEGER; VAR x, y: sINTEGER);
  422. VAR (*$Reg*)  i: sINTEGER;
  423.     dial: tObjcTree;
  424. BEGIN
  425.  dial:= tree;  x:= 0;  y:= 0;  i:= entry;
  426.  WHILE i > 0 DO
  427.   i:= ObjcParent (dial, i);
  428.   INC (x, dial^[i].obX);
  429.   INC (y, dial^[i].obY);
  430.  END;
  431.  INC(x, dial^[entry].obX);
  432.  INC(y, dial^[entry].obY);
  433. END ObjcPos;
  434.  
  435. PROCEDURE ObjcArea (tree: ADDRESS; entry: sINTEGER; VAR rect: ARRAY OF LOC);
  436. VAR r: POINTER TO tRect;
  437. BEGIN
  438.  ObjcRect (tree, entry, rect);
  439.  IF entry > 0 THEN
  440.   r:= ADR (rect);  ObjcPos (tree, entry, r^.x, r^.y);
  441.  END;
  442. END ObjcArea;
  443.  
  444. PROCEDURE ObjcRect (tree: ADDRESS; entry: sINTEGER; VAR rect: ARRAY OF LOC);
  445. VAR dial: tObjcTree;
  446.     r: POINTER TO tRect;
  447. BEGIN
  448.  dial:= tree;  r:= ADR (rect);
  449.  r^.x:= dial^[entry].obX;
  450.  r^.y:= dial^[entry].obY;
  451.  r^.w:= dial^[entry].obWidth;
  452.  r^.h:= dial^[entry].obHeight;
  453. END ObjcRect;
  454.  
  455. PROCEDURE SetObjcRect (tree: ADDRESS; entry: sINTEGER; rect: ARRAY OF LOC);
  456. VAR dial: tObjcTree;
  457.     r: POINTER TO tRect;
  458. BEGIN
  459.  dial:= tree;  r:= ADR (rect);
  460.  dial^[entry].obX:= r^.x;
  461.  dial^[entry].obY:= r^.y;
  462.  dial^[entry].obWidth:= r^.w;
  463.  dial^[entry].obHeight:= r^.h;
  464. END SetObjcRect;
  465.  
  466. PROCEDURE ObjcFrame (tree: ADDRESS; entry: sINTEGER): sINTEGER;
  467. VAR (*$Reg*)  ob: sCARDINAL;
  468.     (*$Reg*)  border: sINTEGER;
  469.     dial: tObjcTree;
  470.     pd:   BOOLEAN;
  471.     ub:   PtrUSERBLK;
  472. BEGIN
  473.  dial:= tree;  border:= 0;  pd:= FALSE;
  474.  WITH dial^[entry] DO
  475.   IF obType = GPROGDEF THEN
  476.    pd:= TRUE;  ub:= dial^[entry].obSpec.address;
  477.   END;
  478.   ob:= GetLowbyte (mtXobjects.GetObtype (tree, entry));
  479.   IF ob = GBUTTON THEN
  480.    border:= -1;
  481.    IF DEFAULT IN obFlags THEN  DEC (border);  END;
  482.    IF Exit    IN obFlags THEN  DEC (border);  END;
  483.   ELSIF ob IN Typeset {GTEXT, GBOXTEXT, GFTEXT, GFBOXTEXT} THEN
  484.    IF pd THEN  border:= ub^.ubPara.TedPtr^.teThickness;
  485.          ELSE  border:= obSpec.TedPtr^.teThickness;
  486.    END;
  487.    IF border > 127 THEN  border:= border - 256;  END;
  488.   ELSIF ob IN Typeset {GBOX, GIBOX, GBOXCHAR} THEN
  489.    IF pd THEN  border:= ORD (ub^.ubPara.Box.frame);
  490.          ELSE  border:= ORD (obSpec.Box.frame);
  491.    END;
  492.    IF border > 127 THEN  border:= border - 256;  END;
  493.   END; (* CASE *)
  494.   IF (OUTLINED IN obState) AND (border > -3) THEN  border:= -3;  END;
  495.  END;
  496.  RETURN border;
  497. END ObjcFrame;
  498.  
  499. PROCEDURE CalcArea (tree: ADDRESS; obj: sINTEGER; VAR rect: ARRAY OF LOC);
  500. VAR (*$Reg*)  ob: sCARDINAL;
  501.     (*$Reg*)  border: sINTEGER;
  502.     dial:  tObjcTree;
  503.     r:     POINTER TO tRect;
  504.     hAdd,
  505.     vAdd: INTEGER;
  506. BEGIN
  507.  dial:= tree;  r:= ADR(rect);
  508.  border:= ObjcFrame (tree, obj);
  509.  ObjcArea (tree, obj, r^);
  510.  IF border < 0 THEN (* Rahmen ausserhalb des Objekts! *)
  511.   border:= ABS (border);
  512.   DEC (r^.x, border);
  513.   DEC (r^.y, border);
  514.   INC (r^.w, border * 2);
  515.   INC (r^.h, border * 2);
  516.  END;
  517.  IF (SHADOWED IN dial^[obj].obState) THEN
  518.   INC (r^.w, border * 2);  INC (r^.h, border * 2);
  519.  END;
  520.  (* Jetzt Anpassung an 3D-Buttons von MTOS *)
  521.  IF (MagicAES.AESGlobal.apVersion >= $0400)
  522.  OR ( (MagicAES.AESGlobal.apVersion >= $0340)
  523.     & (MagicAES.AESGlobal.apVersion # $0399)) (* nicht unter Mag!X *)
  524.  THEN
  525.    IF (MagicAES.FL3DIND IN dial^[obj].obFlags)
  526.    THEN
  527.      (* Ist 3D-Objekt, Anpassung herausfinden *)
  528.      IF MagicAES.ObjcSysvar (0, MagicAES.AD3DVALUE, 0, 0, hAdd, vAdd) > 0
  529.      THEN
  530.        DEC (r^.x, hAdd);
  531.        DEC (r^.y, vAdd);
  532.        INC (r^.w, hAdd*2);
  533.        INC (r^.h, vAdd*2);
  534.      END;
  535.    END;
  536.  END;
  537. END CalcArea;
  538.  
  539. PROCEDURE ScanFlags (tree: ADDRESS; set, entry, flag: sINTEGER): sINTEGER;
  540. VAR (*$Reg*)  o: sINTEGER;
  541.     (*$Reg*)  r: sINTEGER;
  542.     t: tObjcTree;
  543. BEGIN
  544.  IF tree # NIL THEN
  545.   t:= tree;  o:= entry;
  546.   REPEAT
  547.    CASE set OF
  548.     SearchType:  IF flag =  t^[o].obType  THEN  RETURN o;  END;|
  549.     SearchState: IF CastToCard (flag) IN t^[o].obState THEN  RETURN o;  END;|
  550.     SearchFlags: IF CastToCard (flag) IN t^[o].obFlags THEN  RETURN o;  END;|
  551.     ELSE
  552.    END; (* CASE *)
  553.    IF (t^[o].obHead > -1) THEN
  554.     r:= ScanFlags (t, set, t^[o].obHead, flag);
  555.     IF r >= 0 THEN  RETURN r;  END;
  556.    END;
  557.    o:= t^[o].obNext;
  558.   UNTIL o <= entry;
  559.  END; (* IF tree *)
  560.  RETURN -1;
  561. END ScanFlags;
  562.  
  563. PROCEDURE ScanMenu (tree: ADDRESS; scan: sINTEGER; kbshift: sBITSET;
  564.                     VAR title, item: INTEGER): BOOLEAN;
  565. VAR (*$Reg*)  o: sINTEGER;
  566.     p, e, x: sINTEGER;
  567.     t:          tObjcTree;
  568.     s:          ARRAY [0..3] OF CHAR;
  569.     n:          ADDRESS;
  570.     str:        ARRAY [0..80] OF CHAR;
  571.  
  572. BEGIN
  573.  t:= tree;  title:= -1;  item:= -1;  x:= 0;
  574.  
  575.  IF MagicAES.KCTRL IN kbshift THEN
  576.   s[x]:= '^';
  577.  ELSIF MagicAES.KALT IN kbshift THEN
  578.   s[x]:= 07C;
  579.  ELSE
  580.   s[x]:= '['
  581.  END;
  582.  INC (x);
  583.  s[x]:= CAP (CharCode (scan, kbshift));
  584.  IF s[x] = 0C THEN  RETURN FALSE;  END;
  585.  INC (x);  s[x]:= 0C;
  586.  
  587.  title:= t^[t^[t^[0].obHead].obHead].obHead; (* Index erster Titel *)
  588.  o:=  t^[t^[t^[0].obHead].obNext].obHead; (* Index erste Box *)
  589.  
  590.  LOOP (* 1 *)
  591.   item:= t^[o].obHead;
  592.   LOOP (* 2 *)
  593.    IF (t^[item].obType = GSTRING) AND NOT (DISABLED IN t^[item].obState) THEN
  594.     (* ObjcString (t, item, str); *)
  595.     IF Pos (s, t^[item].obSpec.StringPtr^, 0, FALSE) # SIZE (t^[item].obSpec.StringPtr^)  THEN
  596.      MagicAES.MenuTnormal (t, title, 0);
  597.      RETURN TRUE;
  598.     END;
  599.    END;
  600.    IF t^[item].obNext < item THEN  EXIT; (* LOOP 2 *) END;
  601.    item:= t^[item].obNext;
  602.   END; (* LOOP 2 *)
  603.   IF title > t^[title].obNext THEN  EXIT; (* LOOP 1 *) END;
  604.   title:= t^[title].obNext;
  605.   o:= t^[o].obNext;
  606.  END; (* LOOP 1 *)
  607.  RETURN FALSE;
  608. END ScanMenu;
  609.  
  610. PROCEDURE CharCode (scan: sINTEGER; kbshift: sBITSET): CHAR;
  611. VAR tab: MagicXBIOS.PtrKEYTAB;
  612.     ptr: MagicXBIOS.Keycode;
  613.     n:   ADDRESS;
  614. BEGIN
  615.  n:= Nil;  tab:= MagicXBIOS.Keytbl (n, n, n);
  616.  IF (MagicAES.KRSHIFT IN kbshift) OR (MagicAES.KLSHIFT IN kbshift) THEN
  617.   ptr:= tab^.shift;
  618.  ELSIF MagicAES.KCAPS IN kbshift THEN
  619.   ptr:= tab^.capslock;
  620.  ELSE
  621.   ptr:= tab^.unshift;
  622.  END;
  623.  RETURN ptr^[scan];
  624. END CharCode;
  625.  
  626. PROCEDURE ScanCode (ch: CHAR): INTEGER;
  627. VAR tab: MagicXBIOS.PtrKEYTAB;
  628.     ptr: MagicXBIOS.Keycode;
  629.     n:   ADDRESS;
  630.     i:   sINTEGER;
  631. BEGIN
  632.  n:= Nil;  tab:= MagicXBIOS.Keytbl (n, n, n);
  633.  FOR i:= 1 TO 53 DO
  634.   ptr:= tab^.capslock;
  635.   IF ptr^[i] = Cap (ch) THEN RETURN i;  END;
  636.  END;
  637.  RETURN 0;
  638. END ScanCode;
  639.  
  640. PROCEDURE DoubleClick (VAR value: sINTEGER): BOOLEAN;
  641. VAR b: sBITSET;
  642.     double: BOOLEAN;
  643. BEGIN
  644.  b:= CastToBitset (value);
  645.  double:= Bit15 IN b;
  646.  EXCL (b, Bit15);
  647.  value:= CastToInt (b);
  648.  RETURN double;
  649. END DoubleClick;
  650.  
  651. PROCEDURE Bounce;
  652. VAR x, y: sINTEGER;
  653.     button, b: sBITSET;
  654. BEGIN
  655.  REPEAT  GrafMkstate (x, y, button, b);  UNTIL button = {};
  656. END Bounce;
  657.  
  658. PROCEDURE AbsRect (VAR rect: ARRAY OF LOC);
  659. VAR r: POINTER TO tRect;
  660. BEGIN
  661.  r:= ADR (rect);  r^.w:= r^.w + r^.x - 1;  r^.h:= r^.h + r^.y - 1;
  662. END AbsRect;
  663.  
  664. PROCEDURE RelRect (VAR rect: ARRAY OF LOC);
  665. VAR r: POINTER TO tRect;
  666. BEGIN
  667.  r:= ADR (rect);  r^.w:= r^.w - r^.x;  r^.h:= r^.h - r^.y;
  668. END RelRect;
  669.  
  670. PROCEDURE RectToVars (rect: ARRAY OF LOC;  abs: BOOLEAN;
  671.                       VAR x, y, w, h: sINTEGER);
  672. VAR r: POINTER TO tRect;
  673. BEGIN
  674.  r:= ADR (rect);
  675.  x:= r^.x;  y:= r^.y;  w:= r^.w;  h:= r^.h;
  676.  IF abs THEN  INC (w, r^.x);  INC(h, r^.y);  END;
  677. END RectToVars;
  678.  
  679. PROCEDURE VarsToRect (x, y, w, h: sINTEGER; abs: BOOLEAN;
  680.                       VAR rect: ARRAY OF LOC);
  681. VAR r: POINTER TO tRect;
  682. BEGIN
  683.  r:= ADR (rect);
  684.  r^.x:= x;  r^.y:= y;  r^.w:= w;  r^.h:= h;
  685.  IF abs THEN  INC (r^.w, x);  INC(r^.h, y);  END;
  686. END VarsToRect;
  687.  
  688. PROCEDURE AbsRectToVars (rect: ARRAY OF LOC;  abs: BOOLEAN;
  689.                          VAR x, y, w, h: sINTEGER);
  690. VAR r: POINTER TO tRect;
  691. BEGIN
  692.  r:= ADR (rect);
  693.  x:= r^.x;  y:= r^.y;  w:= r^.w;  h:= r^.h;
  694.  IF NOT abs THEN  DEC (w, r^.x);  DEC(h, r^.y);  END;
  695. END AbsRectToVars;
  696.  
  697. PROCEDURE AbsVarsToRect (x, y, w, h: sINTEGER; abs: BOOLEAN;
  698.                          VAR rect: ARRAY OF LOC);
  699. VAR r: POINTER TO tRect;
  700. BEGIN
  701.  r:= ADR (rect);
  702.  r^.x:= x;  r^.y:= y;  r^.w:= w;  r^.h:= h;
  703.  IF NOT abs THEN  DEC (r^.w, x);  DEC(r^.h, y);  END;
  704. END AbsVarsToRect;
  705.  
  706. END mtUtils.
  707.